How to "Hide All Access Objects" using code in MS Access


Here's given an article which will guide you to know "How to hide all access objects including navigation menu and ribbon" using VBA code in MS Access.

The function "VerifyLoadApplication" check for your DB type. If your DB type is "accdb" then all the objects of your database application is set to visible and if your DB type "accde" then all objects of your database application is set to invisible.

Public Function VerifyLoadApplication() As Boolean
Dim RestartApplication As Boolean
RestartApplication = False

If Not (isaccde) Then
EnableShiftEnter
If(CurrentDb.Properties ("StartUpShowDBWindow")=False
Or
CurrentDb.Properties ("StartUpShowStatusBar")= False
Or
CurrentDb.Properties ("AllowShortcutMenus") = False
Or
CurrentDb.Properties ("AllowFullMenus") = False
Or
CurrentDb.Properties ("AllowBuiltInToolbars") = False
Or
CurrentDb.Properties ("AllowToolbarChanges") = False
Or
CurrentDb.Properties ("AllowSpecialKeys") = False
Or
CurrentDb.Properties ("AllowDatasheetSchema") = False) Then
RestartApplication = True
End If

CurrentDb.Properties("NavPane Closed") = 0
CurrentDb.Properties("Show Navigation Pane Search Bar") = 0
CurrentDb.Properties ("StartUpShowDBWindow") = True
CurrentDb.Properties ("StartUpShowStatusBar") = True
CurrentDb.Properties ("AllowShortcutMenus") = True
CurrentDb.Properties ("AllowFullMenus") = True
CurrentDb.Properties ("AllowBuiltInToolbars") = True
CurrentDb.Properties ("AllowToolbarChanges") = True
CurrentDb.Properties ("AllowSpecialKeys") = True
CurrentDb.Properties ("AllowDatasheetSchema") = True
hide_off
IsAppType_Accdb = True

Else

DisableShiftEnter
If (CurrentDb.Properties ("StartUpShowDBWindow") = True
Or
CurrentDb.Properties ("StartUpShowStatusBar") = True
Or
CurrentDb.Properties ("AllowShortcutMenus") = True
Or
CurrentDb.Properties ("AllowFullMenus") = True
Or
CurrentDb.Properties ("AllowBuiltInToolbars") = True
Or
CurrentDb.Properties ("AllowToolbarChanges") = True
Or
CurrentDb.Properties ("AllowSpecialKeys") = True
Or
CurrentDb.Properties ("AllowDatasheetSchema") = True) Then
RestartApplication = True
End If
CurrentDb.Properties("NavPane Closed") = 1
CurrentDb.Properties("Show Navigation Pane Search Bar") = 0
CurrentDb.Properties ("StartUpShowDBWindow") = False
CurrentDb.Properties ("StartUpShowStatusBar") = False
CurrentDb.Properties ("AllowShortcutMenus") = False
CurrentDb.Properties ("AllowFullMenus") = False
CurrentDb.Properties ("AllowBuiltInToolbars") = False
CurrentDb.Properties ("AllowToolbarChanges") = False
CurrentDb.Properties ("AllowSpecialKeys") = False
CurrentDb.Properties ("AllowDatasheetSchema") = False
HideNavigationPane
hide_on
IsAppType_Accdb = False
End If

DoEvents
If RestartApplication Then
VerifyLoadApplication = False
Exit Function
End If
VerifyLoadApplication = True

End Function

This function bypasses the key combination of "SHIFT+ENTER" which generally open the database in debug mode.

Function DisableShiftEnter()
On Error GoTo errDisableShift
Dim DB As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270
Set DB = CurrentDb()
DB.Properties("AllowByPassKey") = False
Exit Function
errDisableShift:
If err = conPropNotFound Then
Set prop = DB.CreateProperty("AllowByPassKey", _
dbBoolean, False)
DB.Properties.Append prop
Resume Next
Else
MsgBox "Function 'DisableShiftEnter' did not complete successfully."
Application.Quit acQuitSaveNone
Exit Function
End If
End Function

This function enables the database to be open in debug mode if "SHIFT+ENTER" is pressed while opening the database.

Function EnableShiftEnter()
On Error GoTo errEnableShift
Dim DB As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270
Set DB = CurrentDb()
DB.Properties("AllowByPassKey") = True
Exit Function
errEnableShift:
If err = conPropNotFound Then
Set prop = DB.CreateProperty("AllowByPassKey", _
dbBoolean, True)
DB.Properties.Append prop
Resume Next
Else
MsgBox "Function 'EnableShiftEnter' did not complete successfully."
Exit Function
End If
End Function

The function hide the navigation bar from the form of your application.

Function HideNavigationPane()
DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.RunCommand acCmdWindowHide
End Function

This function sets all the objects of database application to invisible.

Public Sub hide_on() On Error Resume Next
Dim obj As AccessObject, dbs, dbs1 As Object
Set dbs = Application.CurrentData
Set dbs1 = Application.CurrentProject
For Each obj In dbs.AllTables
Application.SetHiddenAttribute acTable, obj.Name, True
Next obj
For Each obj In dbs.AllQueries
Application.SetHiddenAttribute acQuery, obj.Name, True
Next obj
For Each obj In dbs1.AllForms
If (obj.Name <> "frmUserRegistration") Then
Application.SetHiddenAttribute acForm, obj.Name, True
End If
Next obj
For Each obj In dbs1.AllModules
Application.SetHiddenAttribute acModule, obj.Name, True
Next obj
For Each obj In dbs1.AllReports
Application.SetHiddenAttribute acReport, obj.Name, True
Next obj
For Each obj In dbs1.AllMacros
Application.SetHiddenAttribute acMacro, obj.Name, True
Next obj
End Sub

This function sets all the objects of database application to visible.

Public Sub hide_off()
Dim obj As AccessObject, dbs, dbs1 As Object
Set dbs = Application.CurrentData
Set dbs1 = Application.CurrentProject
For Each obj In dbs.AllTables
If Not (obj.Name Like "MSys*") Then
Application.SetHiddenAttribute acTable, obj.Name, False
End If
Next obj
For Each obj In dbs.AllQueries
Application.SetHiddenAttribute acQuery, obj.Name, False
Next obj
For Each obj In dbs1.AllForms
Application.SetHiddenAttribute acForm, obj.Name, False
Next obj
For Each obj In dbs1.AllModules
Application.SetHiddenAttribute acModule, obj.Name, False
Next obj
For Each obj In dbs1.AllReports
Application.SetHiddenAttribute acReport, obj.Name, False
Next obj
For Each obj In dbs1.AllMacros
Application.SetHiddenAttribute acMacro, obj.Name, False
Next obj
End Sub

This function check the DB type and return the Type of Database application (ACCDB or ACCDE)

Public Function isaccde()
On Error GoTo ErrorHappened
Dim result As Boolean
result = (CurrentDb.Properties("MDE") = "T")
ExitNow:
isaccde = result
Exit Function
ErrorHappened:
Resume ExitNow
End Function


DISCLAIMER

It is advised that the information provided in the article should not be used for any kind formal or production programming purposes as content of the article may not be complete or well tested. ERP Makers will not be responsible for any kind of damage (monetary, time, personal or any other type) which may take place because of the usage of the content in the article.


 

BUY SERVICES CONTACT